home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 July / EnigmA AMIGA RUN 20 (1997)(G.R. Edizioni)(IT)[!][issue 1997-07 & 08][EAR-CD IV].iso / earcd / dev / amos / moreusel.lha / BetterRain.AMOS / BetterRain.amosSourceCode
AMOS Source Code  |  1997-04-15  |  2KB  |  107 lines
  1. ' ************************************ 
  2. ' *                                  * 
  3. ' *     Betterrain & Specialfade     * 
  4. ' *       Written by C. Hodges       *   
  5. ' *                                  * 
  6. ' ************************************ 
  7. '
  8. ' Three litte procedures:
  9. '
  10. ' BETTERRAIN[rainbownumber,length] 
  11. ' Function: Makes rainbows smoother. 
  12. '
  13. ' SPECIALFADE1[speed]
  14. ' Function: Like the fade command, but works by seperating the red, green
  15. '           and blue values. 
  16. '
  17. ' SPECIALFADE2[speed]
  18. ' Function: Fades each colour seperately with a small delay. 
  19. '
  20. Dim SFC(31)
  21. Screen Open 0,320,200,32,0
  22. Curs Off : Flash Off : Paper 0 : Pen 31 : Cls 
  23. Set Rainbow 1,0,200,"","",""
  24. R=0 : G=0 : B=15
  25. For A=0 To 199
  26.   Rain(1,A)=R*$100+G*$10+B
  27.   If(A mod 4)=0 Then B=Max(B-1,0)
  28.   If(A mod 7)=0 and B=0 Then R=Min(R+1,15)
  29.   If(A mod 9)=6 and R=15 Then G=Min(G+1,15)
  30. Next 
  31. Print "This is a normal Rainbow!"
  32. Print "Press any key!"
  33. Rainbow 1,0,49,200
  34. Wait Key 
  35. BETTERRAIN[1,200]
  36. Cls 
  37. Print "And this is BETTERRAIN!"
  38. Print "Press any key!"
  39. View 
  40. Wait Key 
  41. Cls 
  42. Rainbow Del : View 
  43. Load Iff "cam.iff",0
  44. Screen Hide 0
  45. Paper 12 : Pen 10 : Print "Using SPECIALFADE you can"
  46. Print "produce great effects!"
  47. For A=0 To 31 : SFC(A)=Colour(A) : Colour A,0 : Next 
  48. Screen Show 0
  49. SPECIALFADE1[1]
  50. Print "Press any key!"
  51. Wait Key 
  52. For A=0 To 31 : SFC(A)=0 : Next 
  53. SPECIALFADE1[1]
  54. Load Iff "wiesel.iff",0
  55. Screen Hide 0
  56. For A=0 To 31 : SFC(A)=Colour(A) : Colour A,0 : Next 
  57. Screen Show 0
  58. SPECIALFADE2[1]
  59. Wait Key 
  60. For A=0 To 31 : SFC(A)=0 : Next 
  61. SPECIALFADE2[1]
  62. Procedure SPECIALFADE1[T]
  63.   Shared SFC()
  64.   M=$F0 : MU=$10 : Gosub FADRGB
  65.   M=$F00 : MU=$100 : Gosub FADRGB
  66.   M=$F : MU=1 : Gosub FADRGB
  67. Pop Proc
  68. FADRGB:
  69.   Do 
  70.     B=0
  71.     For C=0 To 31
  72.       C1=Colour(C) : C2=SFC(C) and M
  73.       If(C1 and M)<>C2 Then Add C1,Sgn(C2-(C1 and M))*MU : Inc B
  74.       Colour C,C1
  75.     Next 
  76.     Wait T
  77.     Exit If B=0
  78.   Loop 
  79. Return 
  80. End Proc
  81. Procedure SPECIALFADE2[T]
  82.   Shared SFC()
  83.   S=Screen
  84.   Screen Open 7,16,16,2,0 : Screen Hide 7
  85.   For A=0 To 31 : Colour A,SFC(A) : Next 
  86.   Screen S
  87.   B=1 : C=1
  88.   For A=0 To 31
  89.     Fade T To 7,C : Wait T*4
  90.     If A<30 Then B=B*2 : Add C,B Else C=-1 : B=0
  91.   Next 
  92.   Wait T*12
  93.   Screen Close 7
  94. End Proc
  95. Procedure BETTERRAIN[R,L]
  96.   T=1 : AF=Rain(R,0)
  97.   For A=2 To L-1
  98.     Inc T
  99.     If(Rain(R,A)<>AF)
  100.       AF=Rain(R,A)
  101.       If T>3
  102.         Rain(R,A-2)=AF
  103.       End If 
  104.       T=0
  105.     End If 
  106.   Next 
  107. End Proc